perm filename XGPSYN.SAI[PIX,HPM]2 blob
sn#276776 filedate 1977-04-18 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00011 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "XGPSYN"
C00009 00003 DBUG←FALSE
C00010 00004 DO
C00013 00005 FPN←IF XGP THEN 2 ELSE 1 FPNR←0
C00016 00006 DO
C00022 00007 IF PAGE ∧ PN>0 THEN
C00024 00008 comment assemble line of text
C00025 00009 comment calculate height of line
C00031 00010 comment assemble line
C00043 00011 comment dislpay page
C00046 ENDMK
C⊗;
BEGIN "XGPSYN"
REQUIRE "FNTHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "FILHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "SYNSUB.REL[PIX,HPM]" LOAD_MODULE;
EXTERNAL PROCEDURE HELPER;
EXTERNAL PROCEDURE TYPEQ;
EXTERNAL PROCEDURE NOCHAN;
EXTERNAL PROCEDURE FEWCHN(INTEGER N);
EXTERNAL PROCEDURE FIRST;
EXTERNAL PROCEDURE FIRST1;
EXTERNAL PROCEDURE FIRST2;
EXTERNAL PROCEDURE FIRST3;
EXTERNAL PROCEDURE CRLF;
EXTERNAL PROCEDURE FILNM;
EXTERNAL PROCEDURE COLON;
EXTERNAL PROCEDURE FONTNO(INTEGER N);
BOOLEAN PRNT,XGP,DBUG;
INTEGER ARRAY FHD[0:'17,0:'203];
INTEGER FNTN,EOF,FTH,FTB,XPOS,YPOS,XLINE,CHAN,DUN,PN,LASTFF,BASE,SBASE;
INTEGER XCMP,YCMP,YOFF,XOFF,BMAR,RMAR,LMAR,TMAR,PMAR,QUAD,LUND;
INTEGER NCHN,I,NUMCH,TXTPNT;
INTEGER PN1,PN2,PN3;
INTEGER ARRAY PNS[0:300];
STRING INSTR,INFILE,S,SWT;
SIMPLE INTEGER PROCEDURE UCONV(INTEGER I);
RETURN(IF I>'140 ∧ I≤'172 THEN I LAND '137 ELSE I);
SIMPLE INTEGER PROCEDURE NXCH;
BEGIN
WHILE LENGTH(INSTR)=0 ∧ ¬EOF DO INSTR←INPUT(CHAN,1);
NUMCH←NUMCH+1; RETURN(LOP(INSTR));
END;
SIMPLE PROCEDURE MXCH(INTEGER M);
BEGIN
INTEGER I;
IF PRNT THEN FOR I←1 STEP 1 UNTIL M DO IDPB(NXCH,TXTPNT)
ELSE FOR I←1 STEP 1 UNTIL M DO NXCH;
END;
SIMPLE PROCEDURE SMXCH(INTEGER M);
BEGIN
INTEGER I;
FOR I←1 STEP 1 UNTIL M DO NXCH;
END;
SIMPLE INTEGER PROCEDURE PNXCH(INTEGER I);
BEGIN
INTEGER J;
J←I;
WHILE (J←J-1)≥0 ∧ LENGTH(INSTR)<I ∧ ¬EOF DO
INSTR←INSTR&INPUT(CHAN,1) ;
RETURN(INSTR[I TO I]);
END;
PROCEDURE SWITCHES(STRING FNTNMS);
BEGIN
INTEGER FOO;
WHILE LENGTH(FNTNMS)>0 DO
BEGIN
WHILE LENGTH(FNTNMS)>0 ∧ LOP(FNTNMS)≠"/" DO;
IF EQU(FNTNMS[1 TO 5],"FONT#") THEN
BEGIN
INTEGER FTNO; STRING FTNM;
FNTNMS←FNTNMS[6 TO ∞];
FTNO←INTSCAN(FNTNMS,FOO);
FNTNMS←FNTNMS[2 TO ∞];
FTNM←"";
WHILE LENGTH(FNTNMS)>0 ∧ FNTNMS[1 TO 1]≠"/" DO
FTNM←FTNM&LOP(FNTNMS);
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
FONTNO(FTNO); OUTSTR(FTNM); OUTSTR(" ");
WHILE FNTSEL(FTNO,FTNM,FHD[FTNO,0])<0 DO
BEGIN
OUTSTR("COULDN'T GET ");
OUTSTR(DEVPRS); COLON; OUTSTR(FILPRS); CRLF;
OUTSTR("Try again:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
FTNM←INCHWL;
FONTNO(FTNO); OUTSTR(FTNM);
END;
END
ELSE IF EQU(FNTNMS[1 TO 5],"FONT=") THEN
BEGIN
STRING FTNM;
FNTNMS←FNTNMS[6 TO ∞];
FTNM←"";
WHILE LENGTH(FNTNMS)>0 ∧ FNTNMS[1 TO 1]≠"/" DO
FTNM←FTNM&LOP(FNTNMS);
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
OUTSTR("FONT#0="); OUTSTR(FTNM); OUTSTR(" ");
WHILE FNTSEL(0,FTNM,FHD[0,0])<0 DO
BEGIN
OUTSTR("COULDN'T GET "); OUTSTR(DEVPRS);
COLON; OUTSTR(FILPRS); CRLF;
OUTSTR("Try again:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
FTNM←INCHWL;
OUTSTR("FONT#0="); OUTSTR(FTNM); OUTSTR(" ");
END;
END
ELSE IF EQU(FNTNMS[1 TO 5],"TMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
TMAR←INTSCAN(FNTNMS,FOO);
OUTSTR("TMAR="); OUTSTR(CVS(TMAR)); OUTSTR(" ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"PMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
PMAR←INTSCAN(FNTNMS,FOO);
OUTSTR("PMAR="); OUTSTR(CVS(PMAR)); OUTSTR(" ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"BMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
BMAR←INTSCAN(FNTNMS,FOO);
OUTSTR("BMAR="); OUTSTR(CVS(BMAR)); OUTSTR(" ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"LMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
LMAR←INTSCAN(FNTNMS,FOO);
OUTSTR("LMAR="); OUTSTR(CVS(LMAR)); OUTSTR(" ");
END
ELSE IF EQU(FNTNMS[1 TO 5],"RMAR=") THEN
BEGIN
FNTNMS←FNTNMS[6 TO ∞];
RMAR←INTSCAN(FNTNMS,FOO);
OUTSTR("RMAR="); OUTSTR(CVS(RMAR)); OUTSTR(" ");
END
ELSE IF EQU(FNTNMS[1 TO 6],"XLINE=") THEN
BEGIN
FNTNMS←FNTNMS[7 TO ∞];
XLINE←INTSCAN(FNTNMS,FOO);
OUTSTR("XLINE="); OUTSTR(CVS(XLINE)); OUTSTR(" ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"XGP") THEN
BEGIN
FNTNMS←FNTNMS[4 TO ∞];
XGP←TRUE;
OUTSTR("XGP ");
END
ELSE IF EQU(FNTNMS[1 TO 4],"-XGP") THEN
BEGIN
FNTNMS←FNTNMS[5 TO ∞];
XGP←FALSE;
OUTSTR("-XGP ");
END;
END;
END;
DBUG←FALSE;
TYPEQ;
NCHN←0; FOR I←0 STEP 1 UNTIL 2 DO IF SYNMAP(I)>0 THEN NCHN←NCHN+1;
IF NCHN=0 THEN NOCHAN ELSE IF NCHN<3 THEN FEWCHN(NCHN);
BREAKSET(1,"","A"); BREAKSET(1,'0&'177&'12&'14,"I"); BREAKSET(1,"","O");
BREAKSET(1,"","Z");
DDINIT;
TMAR←200;
PMAR←1796;
BMAR←200;
LMAR←200;
RMAR←1650;
XLINE←4;
BEGIN "FILE"
INTEGER FOO,HIG,POS,I,J;
DEFINE FSIZE=4000;
INTEGER ARRAY FONT[0:FSIZE];
STRING FNTNMS;
REAL FPN,FPNR; BOOLEAN PAGE;
FCACHE(FONT[0],FSIZE);
FNTSEL(0,"FIX25.FNT[XGP,SYS]",FHD[0,0]);
DO
BEGIN
STRING SF;
CHAN←GETCHAN;
FILNM; FIRST3; COLON;
TTYUP(TRUE);
S←INCHWL;
TTYUP(FALSE);
SF←""; WHILE LENGTH(S)>0 ∧ S[1 TO 1]≠"/" DO SF←SF&LOP(S);
EOF←TRUE;
IF SF="?" THEN HELPER ELSE
BEGIN "FILE"
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".XGP");
PRSFIL(SF);
OPEN(CHAN,DEVPRS,0,19,0,500,FOO,EOF);
LOOKUP(CHAN,FILPRS,EOF);
END "FILE";
IF EOF THEN
BEGIN "EOF"
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(SF);
OPEN(CHAN,DEVPRS,0,19,0,500,FOO,EOF);
LOOKUP(CHAN,FILPRS,EOF);
END "EOF";
END UNTIL ¬EOF;
BEGIN
STRING FOO,FN2;
FILDEF(FOO,FOO,FN2,FOO,FOO);
XGP←(FN2="XGP");
END;
NUMCH←0; PNS[0]←0;
IF LENGTH(S)>0 THEN SWITCHES(S);
LASTFF←0;
IF XGP THEN
BEGIN
SWT←"";
WHILE PNXCH(1)≠'14 DO
BEGIN
INTEGER NX;
NX←NXCH;
IF NX≠'15∧NX≠'12∧NX≠" " THEN SWT←SWT&NX;
END;
NXCH;
SWITCHES(SWT);
IF LMAR=0 THEN LMAR←150; comment LMAR=0, barfbag PUB default;
PNS[1]←NUMCH;
LASTFF←1;
END;
CRLF;
FPN←IF XGP THEN 2 ELSE 1; FPNR←0;
S←""; PN←2;
OUTSTR("Full density"); CRLF; QUAD←"F";
WHILE TRUE DO
BEGIN "DENSITY"
XCMP←IF QUAD="B"∨QUAD="T" THEN 1 ELSE IF QUAD="D" THEN 6 ELSE 3;
YCMP←IF QUAD="B"∨QUAD="T" THEN 1 ELSE IF QUAD="H" THEN 2 ELSE 4;
BEGIN "PICTURE"
INTEGER HI,WI,BI;
SAFE INTEGER ARRAY PIC[0:PIXDIM(HI←IF QUAD="B" THEN PMAR ELSE
IF QUAD="T" THEN RMAR-LMAR+1
ELSE 481,
WI←IF QUAD="B" THEN RMAR-LMAR+37 ELSE
IF QUAD="T" THEN (PMAR+36) MIN 1650
ELSE 512,
BI←IF QUAD="H" THEN 3
ELSE IF QUAD="F" THEN 4
ELSE IF QUAD="D" THEN 5
ELSE 1)];
MAKPIX(HI,WI,BI,PIC[0]);
NCHN←0;
FOR I←0 STEP 1 UNTIL PIC[BYBI]-1 DO
IF SYNMAP(I)>0 THEN NCHN←NCHN+1;
IF NCHN<PIC[BYBI] THEN
BEGIN
CRLF;
OUTSTR("Could only get "); OUTSTR(CVS(NCHN));
OUTSTR(" synthesizer channel");
OUTSTR(IF NCHN=1 THEN "" ELSE "s");
OUTSTR(", but need "); OUTSTR(CVS(PIC[BYBI]));
OUTSTR(". Image will be degraded."); CRLF; CRLF;
END;
DO
BEGIN "PAGES"
INTEGER FOO;
IF QUAD="D" THEN
BEGIN OUTSTR("FIRST PAGE #"); FIRST; OUTSTR(":"); END
ELSE IF QUAD="F" ∨ QUAD="B" THEN
BEGIN OUTSTR("PAGE #"); FIRST; OUTSTR(":"); END
ELSE
BEGIN OUTSTR("PAGE"); FIRST1; FIRST; OUTSTR(":"); END;
TTYUP(TRUE); S←INCHWL; TTYUP(FALSE);
IF LENGTH(S)=0 THEN
BEGIN
PAGE←TRUE;
END
ELSE IF S="/" THEN
BEGIN
SWITCHES(S);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="X" THEN
BEGIN
IF QUAD="B" THEN VIDXGP(PIC[0],YOFF,XOFF,TMAR+PMAR+BMAR) ELSE
IF QUAD="T" THEN
BEGIN
VIDXGP(PIC[0],0,YOFF,RMAR);
IF DBUG THEN VIDXG(PIC[0],0,YOFF,RMAR);
END
ELSE VIDXGP(PIC[0],0,0,PIC[PCLN]);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="V" THEN
BEGIN
INTEGER I,J;
MAPGRY(IF QUAD="D" THEN 1.5 ELSE 1,PIC[BYBI]);
BEGIN
SAFE INTEGER ARRAY DDB[2:(PIC[BYBI] MAX 2),
0:IF QUAD="B"∨QUAD="T" THEN 0 ELSE DDSIZ];
FOR I←2 STEP 1 UNTIL PIC[BYBI] DO DDSTOR(DDB[I,0]);
IF PIC[BYBI]=1 THEN VID1(PIC[0],DBUF) ELSE
IF PIC[BYBI]=3 THEN VID3(PIC[0],DDB[3,0],DDB[2,0],DBUF) ELSE
IF PIC[BYBI]=4 THEN
VID4(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF) ELSE
VID5(PIC[0],DDB[5,0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF);
FOR J←1,1 DO DPYUP(SYNMAP(0));
FOR I←1 STEP 1 UNTIL PIC[BYBI]-1 DO IF SYNMAP(I)>0 THEN
FOR J←1,1,1 DO DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
END;
IF SYNMAP(0)<0 THEN INCHWL ELSE
BEGIN OUTSTR(" DONE"); CRLF; END;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="O" THEN
BEGIN
OUTSTR("OUTPUT FILE NAME:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
UNGRAY(PIC[0]);
PUTPFL(PIC[0],INCHWL);
GRAY(PIC[0]);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="K" THEN
BEGIN
MAPGRY(-1,0);
PAGE←FALSE;
END
ELSE IF S="?" THEN
BEGIN
HELPER;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="B" ∨ (S LAND '137)="T" ∨ (S LAND '137)="F"
∨ (S LAND '137)="D" ∨ (S LAND '137)="H" THEN
BEGIN
S←S LAND '137;
OUTSTR(IF S="B" THEN "bitwise" ELSE
IF S="T" THEN "bitwise transposed" ELSE
IF S="F" THEN "full" ELSE IF S="H" THEN "half" ELSE "double");
OUTSTR(" density"); CRLF;
QUAD←S;
PN←-1;
PAGE←FALSE;
END
ELSE
BEGIN
INTEGER IPN;
FPN←REALSCAN(S,FOO); IPN←FPN;
FPNR←FPN-IPN+ABS(REALSCAN(S,FOO));
FPN←IPN;
PAGE←TRUE;
END;
IF PAGE THEN PN←FPN;
IF PAGE ∧ PN=1 ∧ XGP THEN
BEGIN
OUTSTR("Page 1 defines fonts, substance begins on page 2"); CRLF;
PAGE←FALSE;
END
ELSE
IF PAGE ∧ PN>0 THEN
BEGIN "NONZERO"
IF EOF ∨ PN≠LASTFF+1 THEN
BEGIN
LASTFF←PN-1;
WHILE LASTFF>0 ∧ PNS[LASTFF]=0 DO LASTFF←LASTFF-1;
EOF←FALSE;
USETI(CHAN,1+PNS[LASTFF]%('200*5));
INSTR←""; NUMCH←(PNS[LASTFF]%('200*5))*'200*5;
FOR I←(PNS[LASTFF] MOD ('200*5)) STEP -1 UNTIL 1 DO NXCH;
END;
WIPE(PIC[0],0);
IF QUAD="T" THEN
BEGIN
YOFF←TMAR-36; XOFF←LMAR;
END
ELSE IF QUAD="B" THEN
BEGIN
YOFF←TMAR; XOFF←LMAR-36;
END
ELSE IF QUAD="H" THEN
BEGIN
YOFF←TMAR+(FPN-PN+FPNR)*(480*4-30)-20;
XOFF←((LMAR-20) MIN (RMAR-3*512)) MAX -10;
END
ELSE IF QUAD="F" THEN
BEGIN
YOFF←TMAR+FPNR*512*4-20;
XOFF←((LMAR-20) MIN (RMAR-3*480)) MAX -10;
END
ELSE
BEGIN
YOFF←TMAR+FPNR*481*4-20;
XOFF←((LMAR-20) MIN (RMAR-3*512)) MAX -10;
END;
comment assemble line of text;
XPOS←LMAR; YPOS←TMAR;
BASE←0; FNTN←0;
FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
WHILE ¬EOF ∧ LASTFF<(IF QUAD="D" THEN PN+1 ELSE PN) DO
BEGIN
INTEGER I,J,LC,YU,YL;
YL←0; YU←0;
PRNT←LASTFF≥PN-1;
IF QUAD="D" ∧ LASTFF=PN THEN
XOFF←(((LMAR-20) MIN (RMAR-3*512))MAX -10)-512*3;
comment calculate height of line;
SBASE←BASE; XPOS←LMAR;
TXTPNT←POINT(7,DBUF,-1); DUN←FALSE;
WHILE ¬DUN∧¬EOF DO
BEGIN "HEIGHT"
PN1←PNXCH(1); PN2←PNXCH(2); PN3←PNXCH(3);
IF PN1=0 THEN SMXCH(1)
ELSE IF PN1='177 THEN
IF PN2='1 THEN
IF PN3≤'17 THEN
BEGIN
FTH←FHD[PN3,FNTHIG];
FTB←FHD[PN3,FNTBAS];
BASE←0;
MXCH(3);
END
ELSE IF PN3='43 THEN
BEGIN
BASE←((PNXCH(4) LSH 29) ASH -29);
MXCH(4);
END
ELSE IF PN3='52 THEN
BEGIN
BASE←BASE+((PNXCH(4) LSH 29) ASH -29);
MXCH(4);
END
ELSE IF PN3='40 THEN
BEGIN
XPOS←PNXCH(4)*128+PNXCH(5);
MXCH(5);
END
ELSE IF PN3='41 THEN
BEGIN
YU←YU MAX ((PNXCH(4) LSH 29) ASH -29);
YL←YL MIN ((PNXCH(4) LSH 29) ASH -29);
XPOS←XPOS+PNXCH(5)*128+PNXCH(6);
MXCH(6);
END
ELSE IF PN3='42 THEN
BEGIN
MXCH(4);
DUN←TRUE;
END
ELSE IF PN3='44 THEN MXCH(3)
ELSE IF PN3='45 THEN MXCH(4+PNXCH(4))
ELSE IF PN3='46 THEN MXCH(3)
ELSE IF PN3='47 THEN
BEGIN
INTEGER YP;
YP←((PNXCH(4) LSH 29) ASH -29);
YU←YU MAX YP; YL←YL MIN YP;
MXCH(4);
END
ELSE IF PN3='50 THEN MXCH(4)
ELSE IF PN3='51 THEN
BEGIN
INTEGER YP;
YP←((PNXCH(5) LSH 29) ASH -29);
YU←YU MAX (YP+PNXCH(4)); YL←YL MIN YP;
MXCH(5);
END
ELSE MXCH(3)
ELSE IF PN2=2 THEN
BEGIN
XPOS←XPOS+((PN3 LSH 29) ASH -29);
MXCH(3);
END
ELSE IF PN2=3 THEN
BEGIN
YPOS←PN3*128+PNXCH(4);
MXCH(4);
END
ELSE IF PN2=4 THEN MXCH(13)
ELSE IF PN2='11
∨ PN2='12
∨ PN2='14
∨ PN2='15
∨ (PN2≥'16 ∧PN2≤'177) THEN
IF XPOS<RMAR THEN
BEGIN
XPOS←XPOS+(FHD[FNTN,PN2] LSH -18);
MXCH(2);
YU←YU MAX (FTH-BASE-FTB); YL←YL MIN (-FTB-BASE);
END
ELSE DUN←TRUE
ELSE MXCH(2)
ELSE IF PN1='15 THEN BEGIN XPOS←LMAR; MXCH(1); END
ELSE IF PN1='11 THEN
BEGIN
INTEGER BLANW;
BLANW←FHD[FNTN,'40] LSH -18;
XPOS←LMAR+((9*BLANW+XPOS-LMAR-1)%(8*BLANW))*8*BLANW;
MXCH(1);
END
ELSE
IF XPOS<RMAR THEN
BEGIN
XPOS←XPOS+(FHD[FNTN,PN1] LSH -18);
IF PN1='12 ∨ PN1='14 THEN
BEGIN
IF PN1='14 THEN
BEGIN
LASTFF←LASTFF+1;
PNS[LASTFF]←NUMCH+1;
OUTSTR(CVS(LASTFF)); OUTSTR(" ");
END;
DUN←TRUE;
END;
MXCH(1);
YU←YU MAX (FTH-BASE-FTB); YL←YL MIN (-FTB-BASE);
END
ELSE DUN←TRUE;
END "HEIGHT";
BASE←SBASE;
comment assemble line;
IF PRNT THEN
BEGIN "ASSEMBLE"
XPOS←LMAR;
FOR I←1 STEP 1 UNTIL 20 DO IDPB(0,TXTPNT);
TXTPNT←POINT(7,DBUF,-1);
YPOS←YPOS-YL;
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTHIG];
WHILE ILDB(TXTPNT)>0 DO
BEGIN "ASSLP"
IF LDB(TXTPNT)='177 THEN
IF ILDB(TXTPNT)='1 THEN
IF ILDB(TXTPNT)≤'17 THEN
BEGIN
FTH←FHD[FNTN←LDB(TXTPNT),FNTHIG];
FTB←FHD[FNTN←LDB(TXTPNT),FNTBAS];
BASE←0;
END
ELSE IF LDB(TXTPNT)='43 THEN
BASE←((ILDB(TXTPNT) LSH 29) ASH -29)
ELSE IF LDB(TXTPNT)='52 THEN
BASE←BASE+((ILDB(TXTPNT) LSH 29) ASH -29)
ELSE IF LDB(TXTPNT)='40 THEN
XPOS←ILDB(TXTPNT)*128+ILDB(TXTPNT)
ELSE IF LDB(TXTPNT)='41 THEN
BEGIN
INTEGER XP,YP,XNEW;
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29))
%YCMP;
XNEW←XPOS+ILDB(TXTPNT)*128+ILDB(TXTPNT);
IF QUAD="F" ∨ QUAD="T" THEN
FOR XP←XPOS STEP 1 UNTIL XNEW DO
ADDEL(PIC[0],PIC[PCLN]-(XP-XOFF)%XCMP,YP,1)
ELSE
FOR XP←XPOS STEP 1 UNTIL XNEW DO
ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
XPOS←XNEW;
END
ELSE IF LDB(TXTPNT)='42 THEN
YPOS←YPOS+YU+ILDB(TXTPNT)
ELSE IF LDB(TXTPNT)='44 THEN BEGIN END
ELSE IF LDB(TXTPNT)='45 THEN
BEGIN
INTEGER N,J;
N←ILDB(TXTPNT);
FOR J←1 STEP 1 UNTIL N DO IBP(TXTPNT);
END
ELSE IF LDB(TXTPNT)='46 THEN LUND←XPOS
ELSE IF LDB(TXTPNT)='47 THEN
BEGIN
INTEGER XP,YP;
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29))
%YCMP;
IF QUAD="F" ∨ QUAD="T" THEN
FOR XP←LUND STEP 1 UNTIL XPOS DO
ADDEL(PIC[0],PIC[PCLN]-(XP-XOFF)%XCMP,YP,1)
ELSE
FOR XP←LUND STEP 1 UNTIL XPOS DO
ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
END
ELSE IF LDB(TXTPNT)='50 THEN IBP(TXTPNT)
ELSE IF LDB(TXTPNT)='51 THEN
BEGIN
INTEGER XP,YP,TH,THK;
THK←ILDB(TXTPNT);
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29))
%YCMP;
IF QUAD="F" ∨ QUAD="T" THEN
FOR XP←LUND STEP 1 UNTIL XPOS DO
FOR TH←THK-1 STEP -1 UNTIL 0 DO
ADDEL(PIC[0],PIC[PCLN]-(XP+TH-XOFF)%XCMP,YP,1)
ELSE
FOR XP←LUND STEP 1 UNTIL XPOS DO
FOR TH←THK-1 STEP -1 UNTIL 0 DO
ADDEL(PIC[0],YP,(XP+TH-XOFF)%XCMP,1);
END
ELSE BEGIN END
ELSE IF LDB(TXTPNT)=2 THEN
XPOS←XPOS+((ILDB(TXTPNT) LSH 29) ASH -29)
ELSE IF LDB(TXTPNT)=3 THEN
YPOS←ILDB(TXTPNT)*128+ILDB(TXTPNT)-YL
ELSE IF LDB(TXTPNT)=4 THEN
BEGIN
INTEGER J,K,Y0,N,W; REAL DX,X0;
Y0←ILDB(TXTPNT)*128+ILDB(TXTPNT);
X0←ILDB(TXTPNT)*128+ILDB(TXTPNT);
DX←((ILDB(TXTPNT)*16384+ILDB(TXTPNT)*128+ILDB(TXTPNT))
LSH 15) ASH -15;
DX←DX/2↑9;
N←ILDB(TXTPNT)*128+ILDB(TXTPNT);
W←ILDB(TXTPNT)*128+ILDB(TXTPNT);
FOR J←0 STEP 1 UNTIL N-1 DO
FOR K←0 STEP 1 UNTIL W-1 DO
IF QUAD="F" ∨ QUAD="T" THEN
ADDEL(PIC[0],PIC[PCLN]-(K+X0+DX*J-XOFF)%XCMP,
(J+Y0-YOFF)%YCMP,1)
ELSE
ADDEL(PIC[0],(J+Y0-YOFF)%YCMP,
(K+X0+DX*J-XOFF)%XCMP,1);
END
ELSE IF LDB(TXTPNT)='11 ∨
LDB(TXTPNT)='12 ∨
LDB(TXTPNT)='14 ∨
LDB(TXTPNT)='15 ∨
(LDB(TXTPNT)≥'16 ∧ LDB(TXTPNT)≤'177) THEN
BEGIN
IF QUAD="H" THEN
CHR3X2(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF)
ELSE IF QUAD="F" THEN
CHR3Y4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF)
ELSE IF QUAD="D" THEN
CHR6X4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF)
ELSE IF QUAD="T" THEN
CHRPED(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP)
ELSE
CHRDEP(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP);
XPOS←XPOS+(FHD[FNTN,LDB(TXTPNT)] LSH -18);
END
ELSE BEGIN END
ELSE IF LDB(TXTPNT)='12 THEN
YPOS←YPOS+YU+XLINE
ELSE IF LDB(TXTPNT)='15 THEN
XPOS←LMAR
ELSE IF LDB(TXTPNT)='11 THEN
BEGIN
INTEGER BLANW;
BLANW←FHD[FNTN,'40] LSH -18;
XPOS←LMAR+((9*BLANW+XPOS-LMAR-1)%(8*BLANW))*8*BLANW;
END
ELSE IF LDB(TXTPNT)='14 THEN
BEGIN
XPOS←LMAR;
YPOS←TMAR;
END
ELSE IF LDB(TXTPNT)≠0 THEN
BEGIN
IF QUAD="H" THEN
CHRDEP(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP)
ELSE IF QUAD="F" THEN
CHR3Y4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF)
ELSE IF QUAD="D" THEN
CHR6X4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF)
ELSE IF QUAD="T" THEN
CHRPED(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP)
ELSE
CHRDEP(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP);
XPOS←XPOS+(FHD[FNTN,LDB(TXTPNT)] LSH -18);
END
ELSE ;
END"ASSLP";
END "ASSEMBLE";
END;
comment dislpay page;
MAPGRY(IF QUAD="D" THEN 1.5 ELSE 1,PIC[BYBI]); GRAY(PIC[0]);
BEGIN
SAFE INTEGER ARRAY DDB[2:(PIC[BYBI] MAX 2),
0:IF QUAD="B"∨QUAD="T" THEN 0 ELSE DDSIZ];
DDINIT;
FOR I←2 STEP 1 UNTIL PIC[BYBI] DO DDSTOR(DDB[I,0]);
IF PIC[BYBI]=1 THEN VID1(PIC[0],DBUF) ELSE
IF PIC[BYBI]=3 THEN VID3(PIC[0],DDB[3,0],DDB[2,0],DBUF) ELSE
IF PIC[BYBI]=4 THEN
VID4(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF) ELSE
VID5(PIC[0],DDB[5,0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF);
FOR J←1,1 DO DPYUP(SYNMAP(0));
FOR I←1 STEP 1 UNTIL PIC[BYBI]-1 DO IF SYNMAP(I)>0 THEN
FOR J←1,1,1 DO DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
END;
IF SYNMAP(0)<0 THEN INCHWL ELSE
BEGIN OUTSTR(" DONE"); FIRST2; CRLF; END;
IF QUAD="H"∨QUAD="T" THEN FPN←FPN+.5 ELSE
IF QUAD="F"∨QUAD="B" THEN FPN←(PN←FPN)+1 ELSE
IF QUAD="D" THEN FPN←(PN←FPN)+2;
END "NONZERO";
END "PAGES"
UNTIL PN<0;
END "PICTURE";
END "DENSITY";
END "FILE";
END "XGPSYN";